Spatial Analysis Report

Code 
is_empty_nested_list <- function(x) {
    class(x) == "list" & length(x[[1]]) == 0
}

parse_list_arg <- function(arg) {
    if (length(arg) == 0 | is_empty_nested_list(arg) | arg == "") {
        return(NULL)
    }
    return(strsplit(arg, ":")[[1]])
}

# see https://github.com/quarto-dev/quarto-r/issues/211#issuecomment-2340880323
write_meta <- function(meta) {
    handlers <- list(logical = function(x) {
        value <- ifelse(x, "true", "false")
        structure(value, class = "verbatim")
    })
    res <- yaml::as.yaml(meta, handlers = handlers)
    knitr::asis_output(paste0("---\n", res, "---\n"))
}

hierarchy_file <- params$hierarchy_file
expression_file <- params$expression_file

stopifnot(file.exists(hierarchy_file))
stopifnot(file.exists(expression_file))

sample_name <- params$sample_name
sample_id <- params$sample_id
marker_col <- params$marker_col
markers <- parse_list_arg(params$markers)
cell_types <- parse_list_arg(params$cell_types)
parent_types <- parse_list_arg(params$parent_types)
metadata_cols <- parse_list_arg(params$metadata_cols)
plot_metas <- parse_list_arg(params$plot_metas)

# deal with booleans -- more cumbersome
are_markers_split <- ifelse(is_empty_nested_list(params$are_markers_split),
                        FALSE, params$are_markers_split)
plot_heatmaps <- ifelse(is_empty_nested_list(params$plot_heatmaps),
                        TRUE, params$plot_heatmaps)
plot_props <- ifelse(is_empty_nested_list(params$plot_props),
                        TRUE, params$plot_props)
plot_umap <- ifelse(is_empty_nested_list(params$plot_umap),
                        TRUE, params$plot_umap)
plot_clusters <- ifelse(is_empty_nested_list(params$plot_clusters),
                        TRUE, params$plot_clusters)
plot_spatial <- ifelse(is_empty_nested_list(params$plot_spatial),
                        TRUE, params$plot_spatial)
save_rdata <- ifelse(is_empty_nested_list(params$save_rdata),
                        TRUE, params$save_rdata)

# update boolean meta args so that quarto recognises them if they were
# overwritten by the parameter input flags
write_meta(list(params = list(
                            plot_heatmaps = plot_heatmaps,
                            plot_props = plot_props,
                            plot_umap = plot_umap,
                            plot_clusters = plot_clusters,
                            plot_spatial = plot_spatial)))

Test

Code 
params_table <- data.frame(
    Parameter = c("Hierarchy File", "Expression File", "Sample Name", "Markers", "Cell Types", "Parent Types"),
    Value = c(
        hierarchy_file,
        expression_file,
        sample_name,
        paste(markers, collapse = ", "),
        paste(cell_types, collapse = ", "),
        paste(parent_types, collapse = ", ")
    )
)

knitr::kable(params_table, format = "markdown", col.names = c("Parameter", "Value"))
Parameter Value
Hierarchy File inst/extdata/hierarchy.yaml
Expression File data-raw/simulated.csv
Sample Name Test
Markers
Cell Types
Parent Types

Marker heatmaps

Heatmap showing the mean intensity of the specified markers across the specified cell. All markers and cell types are shown if none are specified.

Code 
plot_marker_heatmap(
    spe,
    markers = markers,
    cell_types = cell_types
)

Heatmap showing the proportion of markers that are positive for the specified cell types. Note that these markers are obtained from the marker metadata, and may not be the same markers plotted in the heatmap above.

Code 
plot_marker_heatmap(
    spe,
    markers = NULL,
    cell_types = cell_types,
    parent_types = parent_types,
    value = "proportion"
)

Cell type proportions

Proportions plot showing the high-level (Hierarchy 1) cell types in the sample.

Code 
plot_cell_props(
    spe,
    cell_type_colname = "HierarchyLevel1"
)

Proportions plot showing Hierarchy Level 4 cell types, optionally filtered by a parent cell type (Hierarchy 1).

Code 
plot_cell_props(
    spe,
    parent_types = parent_types
)

UMAP

UMAP showing high-level (Hierarchy 1) cell types.

Code 
plot_umap(
    spe,
    cell_type_colname = "HierarchyLevel1"
)

UMAP filtered by specified cell and parent types.

Code 
plot_umap(
    spe,
    parent_types = parent_types,
    cell_types = cell_types
)

Cluster memberships

High-level (Hierarchy 1) cell type membership for each cluster as a bar plot and as a heatmap.

Code 
spe <- create_spatial_clusters(spe)
plot_cluster_cell_props(
    spe,
    cell_type_colname = "HierarchyLevel1",
    exclude_parent_types = "Other"
)

Cell type memberships of each cluster for only the specified cell type (or all cell types if was specified). Shown as a bar plot and heatmap.

Code 
plot_cluster_cell_props(
    spe,
    cell_types = cell_types,
    parent_types = parent_types
)

Code 
plot_cluster_cell_props(
    spe,
    cell_types = cell_types,
    parent_types = parent_types,
    plot_type = "heatmap"
)

Spatial cell types

Spatial plots showing cell locations, optionally filtered by a high-level cell type.

Code 
plot_cells_spatially(
    spe,
    parent_types = parent_types
)

Spatial plot as above, coloured by clusters.

Code 
plot_cells_spatially(
    spe,
    parent_types = parent_types,
    colour_by = "cluster"
)

Spatial plot coloured by metadata col if present.

Code 
for (meta_col in plot_metas) {
    plot_cells_spatially(
        spe,
        parent_types = parent_types,
        colour_by = meta_col
    ) |> show()
}

Code 
outfile <- paste0(sample_name, ".rds")
saveRDS(spe, outfile, compress = "xz")